COMMENT ⊗   VALID 00009 PAGES
C REC  PAGE   DESCRIPTION
C00001 00001
C00002 00002	ss(tdvsbu,Static and dynamic ways of programming.)
C00003 00003	ss(numrec,Recursive definition of functions on natural numbers.)
C00005 00004	ss(listrec,Simple list recursion.)
C00006 00005	ss(sexprec,Simple S-expression recursion.)
C00007 00006	ss(strucrec,Other structural recursions.)
C00009 00007	ss(treerec,General tree recursion.)
C00011 00008	ss(soln, Solving a LISP programming problem.)
C00014 00009	
C00015 ENDMK
C⊗;
;;;ss(tdvsbu,Static and dynamic ways of programming.)

(DEFUN FACTORIAL (N)
  (COND ((EQUAL N 0) 1) (T (TIMES N (FACTORIAL (SUB1 N)))) ))

(DEFUN FACT (N)
  (PROG (I X)
    (SETQ I N)
    (SETQ S 1)
  LOOP		
    (COND ((EQUAL I 0) (RETURN S)) )
    (SETQ S (TIMES I S)
    (SETQ I (SUB1 I))
    (GO LOOP)
  ) ))

(DEFUN FACT1 (I S)
  (COND ((EQUAL I 0) S) (T (FACT1 (SUB1 I) (TIMES I S))) ))

(DEFUN FACT0 (N) (FACT1 N 1))

;;;ss(numrec,Recursive definition of functions on natural numbers.)

(DEFUN PLUS (N M) 
  (COND ((EQUAL N 0) M) (T (ADD1 (PLUS (SUB1 N) M)))))

(DEFUN DIFFER (N M)
  (COND ((EQUAL N 0) 0) ((EQUAL M 0) N) (T (DIFFER (SUB1 N) (SUB1 M))) ))

(DEFUN GREATERP (N M)
  (COND ((EQUAL N 0) 0) ((EQUAL M 0) 1) (T (GREATERP (SUB1 N) (SUB1 M))) ))

(DEFUN FIB (N)
  (COND ((EQUAL N 0) 0)
	((EQUAL N 1) 1)
	(T (PLUS (FIB (SUB1 N)) (FIB (SUB1 (SUB1 N))))) ))


;;;⊗⊗⊗fiba[n] ← fibb[n,$$0$,$$1$]                 ⊗
;;;!fcnfib&a 
;;;⊗⊗⊗fibb[n,k,m] ← qif n=$0 qthen k qelse fibb[n-$$1$,m,m+k]⊗

(DEFUN FIBA (N) (FIBB N 0 1))

(DEFUN FIBB (N K M) (COND ((EQUAL N 0) K) (T (FIBB (SUB1 N) M (PLUS K M))) ))

;;;!fcnack& ⊗⊗⊗   ack[m,n] ← qif m=$0 qthen n+$1 qelse qif n=$0 qthen ack[m-$$1$,$$1$]
;;;qelse ack[m-$$1$,ack[m,n-$$1$]]⊗.

(DEFUN ACK (M N)
  (COND ((EQUAL M 0) (ADD1 N))
	((EQUAL N 0) (ACK (SUB1 M) 1))
	(T (ACK (SUB1 M) (ACK M (SUB1 N)))) ))

;;;ss(listrec,Simple list recursion.)

;;;APPEND READIN[206,CLT]

(DEFUN MEMBER% (X U) 
  (COND ((NULL U) NIL) (T (OR (EQUAL X (CAR U)) (MEMBER% X (CDR U)))) ))

;;;REVERSE1 READIN[206,CLT]
;;;LAST READIN[206,CLT]
;;;LENGTH READIN[206,CLT]

;;;ss(sexprec,Simple S-expression recursion.)

;;;SUBST READIN[206,CLT]

(DEFUN SIZE (X) (COND ((ATOM X) 1) (T (PLUS (SIZE (CAR X)) (SIZE (CDR X))))))

(DEFUN EQUAL (X Y)
  (COND ((ATOM X) (COND ((ATOM Y) (EQ X Y)) (T NIL)))
	((ATOM Y) NIL)
	(T (AND (EQUAL (CAR X) (CAR Y)) (EQUAL (CDR X) (CDR Y))))))
;;;FRINGE READIN[206,CLT]
;;;FRINGE READIN[206,CLT]
;;;FLATTEN READIN[206,CLT]

;;;ss(strucrec,Other structural recursions.)


(DEFUN ISNUM (E) (NUMBERP E))
(DEFUN CVAL (E) E)

(DEFUN ISVAR (E) (AND (NOT (NUMBERP E)) (ATOM E)))
(DEFUN LOOKUP (E A) (CDR (ASSOC E A)))

(DEFUN ISSUM (E) (EQ (CAR E) 'PLUS))
(DEFUN S1 (E) (CADR E))
(DEFUN S2 (E) (CADDR E))
(DEFUN SUM (E1 E2) (PLUS E1 E2))

(DEFUN ISPROD (E) (EQ (CAR E) 'TIMES))
(DEFUN P1 (E) (CADR E))
(DEFUN P2 (E) (CADDR E))
(DEFUN PROD (E1 E2) (TIMES E1 E2))

(DEFUN NVAL (E A)
  (COND ((ISNUM E) (CVAL E))
	((ISVAR E) (LOOKUP E A))
	((ISSUM E) (SUM (NUMVAL (S1 E) A) (NUMVAL (S2 E) A)))
	((ISPROD E) (PROD (NUMVAL (S1 E) A) (NUMVAL (S2 E) A)))))

;;;ss(treerec,General tree recursion.)


(DEFUN SEARCH (P) (COND ((LOSE P) 'LOSE) ((TER P) P) (T (SEARCHLIS (SUCCESSORS P)))))

(DEFUN SEARCHLIS (U) 
  (COND ((NULL U) 'LOSE) 
	(T ((LAMBDA (X) 
	      (COND ((EQ X 'LOSE)(SEARCHLIS (CDR U))) (T X))) (SEARCH (CAR U))))))


(DEFUN LOSE (P) (MEMBER (CAR P) (CDR P)))

(DEFUN TER (P) (EQ (CAR P) FINAL))

(DEFPROP SUCCESSORS 
  (LAMBDA (P) (MAPCAR (FUNCTION (LAMBDA (X) (CONS X P)))
                      (CDR (ASSOC (CAR P) GRAPH))))
S1)

(DEFUN ALLSOL1 (P) (COND ((LOSE P) NIL)
		((TER P) (LIST P))
		(T (MAPAPP (FUNCTION ALLSOL1) (SUCCESSORS P)))))

(DEFUN ALLSOL (P) (ALLSOLA P NIL))

(DEFUN ALLSOLA (P FOUND) (COND
	((LOSE P) FOUND)
	((TER P) (CONS P FOUND))
	(T (ALLSOLB (SUCCESSORS P) FOUND))))

(DEFUN ALLSOLB (U FOUND) (COND
	((NULL U) FOUND)
	(T (ALLSOLB (CDR U) (ALLSOLA (CAR U) FOUND)))))

;;;ss(soln, Solving a LISP programming problem.)
(DEFUN ALLSUB (U V) (ALLSUB1 U V 1)) 

(DEFUN ALLSUB1 (U V P) 
       (COND ((NULL V) NIL)
	     ((MATCH U V) (CONS P (ALLSUB1 U (CDR V) (ADD1 P))))
	     (T (ALLSUB1 U (CDR V) (ADD1 P))))) 

(DEFUN MATCH (U V) 
       (COND ((NULL U) T)
	     ((NULL V) NIL)
	     (T (AND (EQUAL (CAR U) (CAR V))
		     (MATCH (CDR U) (CDR V)))))) 

(DEFUN ALLPOS (V) (ALLPOS1 V 1))
(DEFUN ALLPOS1 (V N)
  (COND ((NULL V) NIL)
	((ATOM (CAR V)) (CONS (LIST N) (ALLPOS1 (CDR V) (ADD1 N))))
	(T (CONS (LIST N) 
		 (APPEND (TACK N (ALLPOS (CAR V))) (ALLPOS1 (CDR V) (ADD1 N))))) ))

(DEFUN TACK (N W) (COND ((NULL W) NIL) (T (CONS (CONS N (CAR W)) (TACK N (CDR W)))) ))

(DEFUN ALLSUBSUB (U V) (ALLSUBSUB1 U V 1))
(DEFUN ALLSUBSUB1 (U V N)
  (COND ((NULL V) NIL)
	((MATCH U V) (CONS (LIST N) (ALLSUBSUB1 U (CDR V) (ADD1 N))))
	((ATOM (CAR V)) (ALLSUBSUB1 U (CDR V) (ADD1 N)))
	(T (APPEND (TACK N (ALLSUBSUB U (CAR V))) (ALLSUBSUB1 U (CDR V) (ADD1 N)))) ))

(DEFUN ALLPOS% (V) (ALLPOS1% V '(1)))
(DEFUN ALLPOS1% (V P)
  (COND ((NULL V) NIL)
	((ATOM (CAR V))
	 (CONS (REVERSE P) (ALLPOS1% (CDR V) (CONS (ADD1 (CAR P)) (CDR P)))) )
	(T (CONS (REVERSE P) 
	         (APPEND (ALLPOS1% (CAR V) (CONS 1 P)) 
			 (ALLPOS1% (CDR V) (CONS (ADD1 (CAR P)) (CDR P)))))) ))

(DEFUN ALLSUBSUB% (U V) (ALLSUBSUB1% U V '(1)))
(DEFUN ALLSUBSUB1% (U V P)
  (COND ((NULL V) NIL)
	((MATCH U V)
	 (CONS (REVERSE P) (ALLSUBSUB1% U (CDR V) (CONS (ADD1 (CAR P)) (CDR P)))) )
	((ATOM (CAR V)) (ALLSUBSUB1% U (CDR V) (CONS (ADD1 (CAR P)) (CDR P))) )
	(T (APPEND (ALLSUBSUB1% U (CAR V) (CONS 1 P)) 
		   (ALLSUBSUB1% U (CDR V) (CONS (ADD1 (CAR P)) (CDR P))))) ))